home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / ace_gpl_release / src_ansi / ace / c / warns.c < prev    next >
Encoding:
C/C++ Source or Header  |  1999-01-03  |  20.5 KB  |  851 lines
  1. #include "acedef.h"
  2. #include <string.h>
  3. #include <clib/dos_protos.h>
  4. #include <clib/intuition_protos.h>
  5.  
  6. /* local variables */
  7. extern struct Remember *GenRememberList;
  8. extern struct Remember *SymRememberList[2];
  9.  
  10. /* Externals */
  11.  
  12. extern int lev;
  13. extern int sym;
  14. extern int typ;
  15. extern int errors;
  16. extern int exitvalue;
  17. extern int addr[2];
  18. extern char string_const_start[7];
  19. extern char string_const_end[4];
  20. extern char id[MAXIDSIZE];
  21. extern char exit_sub_name[80];
  22. extern FILE *dest;
  23. extern SYM *curr_item;
  24. extern CODE *curr_code;
  25. extern BOOL early_exit;
  26. extern BOOL optimise_opt;
  27. extern BOOL module_opt;
  28. extern BOOL cli_args;
  29. extern BOOL translateused;
  30. extern BOOL mathffpused;
  31. extern BOOL mathtransused;
  32. extern BOOL gfxused;
  33. extern BOOL intuitionused;
  34. extern BOOL iffused;
  35. extern BOOL ontimerused;
  36. extern BOOL narratorused;
  37. extern BOOL basdatapresent;
  38. extern BOOL readpresent;
  39. extern BOOL make_icon;
  40. extern BOOL end_of_source;
  41.  
  42. /* locals */
  43. static char *frame_ptr[] ={"(a4)", "(a5)"};
  44.  
  45. /* functions  alloc.c */
  46. void *alloc (unsigned int bytes, unsigned long flags)
  47. {
  48. /* allocate memory as requested */
  49.  
  50.   return ((void *) AllocRemember (&GenRememberList, bytes, flags));
  51. }
  52.  
  53. void *sym_alloc (unsigned int bytes, unsigned long flags)
  54. {
  55. /* allocate memory for current level's symbol table as requested */
  56.  
  57.   return ((void *) AllocRemember (&SymRememberList[lev], bytes, flags));
  58. }
  59.  
  60.  
  61. /* functions  assign.c */
  62. void make_data_const (char *string)
  63. {
  64.   char *strbuf;
  65.  
  66.   /* actual string constant */
  67.   strbuf = (char *) alloc (strlen (string) + 10L, MEMF_ANY);
  68.   /* +10 is for string_const_start/end (9) & '\0' */
  69.   strcpy (strbuf, string_const_start);
  70.   strcat (strbuf, string);
  71.   strcat (strbuf, string_const_end);
  72.   enter_BASDATA (strbuf);
  73.   /*FreeMem(strbuf,strlen(string)+10); */
  74. }
  75.  
  76.  
  77. BOOL search_func (char *bmap, char *func, SYM * declared_func)
  78. {
  79. /* 
  80.    ** Search for function in .bmap file, recording register usage
  81.    ** and library base offset in symbol table entry for function. 
  82.  */
  83.  
  84.   unsigned char *buf;
  85.   struct FileHandle *f;
  86.   unsigned char ch, name[MAXIDSIZE];
  87.   long bmap_size = 5000, count, cc, rc;
  88.   SHORT offset = 0;
  89.   BOOL found = FALSE;
  90.  
  91.     {
  92.       f = (struct FileHandle *) Open ((STRPTR) bmap, MODE_OLDFILE);
  93.  
  94.       if( !f )
  95.       {
  96.         _error( 50 );
  97.         return FALSE;
  98.       }
  99.  
  100.       Seek( (BPTR) f, 0, OFFSET_END );
  101.       bmap_size = Seek( (BPTR) f, 0, OFFSET_BEGINNING );
  102.  
  103.       /* read whole bmap file into a buffer */
  104.       buf = (unsigned char *) alloc (bmap_size, MEMF_ANY);
  105.  
  106.       Read ((BPTR) f, buf, bmap_size);
  107.       Close ((BPTR) f);
  108.  
  109.       count = 0;        /* start of buffer */
  110.  
  111.       while (!found && count < bmap_size)
  112.     {
  113.       /* build function name */
  114.       cc = 0;
  115.       while (count < bmap_size && cc < MAXIDSIZE)
  116.         {
  117.           ch = name[cc++] = buf[count++];
  118.           if (ch == '\0')
  119.         break;        /* exit loop when EOS reached */
  120.         }
  121.  
  122.       name[cc - 1] = '\0';    /* make sure we have an EOS symbol (may exit early) */
  123.  
  124.       if (strcmp ((char *) name, func) != 0)
  125.         {
  126.           /* skip 2-byte offset */
  127.           count += 2;
  128.           /* skip to next name */
  129.           while (count < bmap_size && (ch = buf[count++]) != '\0');
  130.         }
  131.       else
  132.         found = TRUE;    /* that's it! -> get the info' */
  133.     }
  134.  
  135.       if (!found)
  136.     return (FALSE);
  137.  
  138.       /* get library base offset (2 bytes) */
  139.       if (count < bmap_size)
  140.     {
  141.       ch = buf[count++];
  142.       offset += ch * 256;
  143.     }
  144.       else
  145.     return (FALSE);
  146.  
  147.       if (count < bmap_size)
  148.     {
  149.       ch = buf[count++];
  150.       offset += ch;
  151.     }
  152.       else
  153.     return (FALSE);
  154.  
  155.       declared_func->address = (SHORT) offset;    /* record library base offset */
  156.  
  157.       /* get n bytes of register data */
  158.       declared_func->reg = (UBYTE *) sym_alloc (15, MEMF_ANY);
  159.       if (declared_func->reg == NULL)
  160.     {
  161.       puts ("Can't allocate memory for function register info!");
  162.       early_exit = TRUE;
  163.       kill_all_lists ();
  164.       cleanup ();
  165.     }
  166.  
  167.       rc = 0;
  168.       while (count < bmap_size &&
  169.          (ch = buf[count++]) != '\0')
  170.     declared_func->reg[rc++] = ch;
  171.  
  172.       declared_func->no_of_params = rc;        /* record no. of parameters */
  173.  
  174.       if (ch != '\0')
  175.     return (FALSE);        /* last character should be NULL */
  176.  
  177.       /* we found it -> return */
  178.       return (TRUE);
  179.     }
  180. }  
  181.  
  182. /* functions  misc.c */
  183.  
  184. void push_num_constant (int typ, SYM * item)
  185. {
  186. /* push a numeric
  187.    constant onto 
  188.    the stack. 
  189.  */
  190.   char buf[40], numbuf[40];
  191.  
  192.   strcpy (numbuf, "#\0");
  193.   switch (typ)
  194.     {
  195.     case shorttype:
  196.       itoa (item->numconst.shortnum, buf, 10L);
  197.       break;
  198.     case longtype:
  199.       ltoa (item->numconst.longnum, buf, 10);
  200.       break;
  201.     case singletype:
  202. /*  sprintf (buf, "%lx", item->numconst.singlenum); original */
  203.       sprintf (buf, "%x", item->numconst.singlenum);
  204.       strcat (numbuf, "$");
  205.       break;
  206.     }
  207.  
  208.   strcat (numbuf, buf);
  209.  
  210.   if (typ == shorttype)
  211.     gen ("move.w", numbuf, "-(sp)");
  212.   else
  213.     gen ("move.l", numbuf, "-(sp)");
  214. }
  215.  
  216. /* functions  parse.c */
  217.  
  218. void compile (char *source_name, char *dest_name)
  219. {
  220.   char buf[40], bytes[40], icon_name[MAXSTRLEN];
  221.   FILE *icon_src, *icon_dest;
  222.   int cc;
  223.  
  224.   /* 
  225.      ** Parse the source file producing XREFs, code, data, 
  226.      ** bss & basdata segments.
  227.    */
  228.   parse ();
  229.  
  230.   /* optimise? */
  231.   if (optimise_opt && !early_exit)
  232.     optimise ();
  233.  
  234.   if (!module_opt)
  235.     {
  236.       /* startup xrefs for startup.lib */
  237.       enter_XREF ("_startup");
  238.       enter_XREF ("_cleanup");
  239.  
  240.       /* command line argument xref */
  241.       if (cli_args)
  242.     enter_XREF ("_parse_cli_args");
  243.  
  244.       if (translateused)
  245.     {
  246.       enter_XREF ("_opentranslator");
  247.       enter_XREF ("_closetranslator");
  248.     }
  249.  
  250.       if (mathffpused)
  251.     {
  252.       enter_XREF ("_openmathffp");
  253.       enter_XREF ("_closemathffp");
  254.     }
  255.  
  256.       if (mathtransused)
  257.     {
  258.       enter_XREF ("_openmathtrans");
  259.       enter_XREF ("_closemathtrans");
  260.     }
  261.  
  262.       if (gfxused)
  263.     {
  264.       enter_XREF ("_opengfx");
  265.       enter_XREF ("_closegfx");
  266.       enter_XREF ("_openintuition");
  267.       enter_XREF ("_closeintuition");
  268.     }
  269.  
  270.       if (intuitionused)
  271.     {
  272.       enter_XREF ("_openintuition");
  273.       enter_XREF ("_closeintuition");
  274.     }
  275.  
  276.       if (iffused)
  277.     {
  278.       enter_XREF ("_create_ILBMLib");
  279.       enter_XREF ("_remove_ILBMLib");
  280.     }
  281.  
  282.       enter_XREF ("_starterr");
  283.  
  284.       /*
  285.          ** A module may need to jump to _EXIT_PROG so
  286.          ** make this label externally referenceable (* = XDEF).
  287.        */
  288.       enter_XREF ("*EXIT_PROG");
  289.  
  290.       if (ontimerused)
  291.     enter_XREF ("_ontimerstart");
  292.  
  293.       /*
  294.          ** Always call this in case a db.lib function 
  295.          ** allocates memory via alloc(). This also takes
  296.          ** care of the use of ALLOC by an ACE program.
  297.          ** To do this we always need to externally 
  298.          ** reference the free_alloc() function.
  299.        */
  300.       enter_XREF ("_free_alloc");
  301.     }
  302.   else
  303.     {
  304.       /*
  305.          ** Current module may need to jump to _EXIT_PROG, so externally reference it.
  306.        */
  307.       enter_XREF ("_EXIT_PROG");
  308.     }
  309.  
  310.   /* DATA statements? */
  311.   if (basdatapresent)
  312.     enter_BSS ("_dataptr:", "ds.l 1");
  313.   if ((readpresent) && (!basdatapresent))
  314.     _error (25);
  315.  
  316.   /* ------------------------------------------------- */
  317.   /* create A68K compatible 68000 assembly source file */
  318.   /* ------------------------------------------------- */
  319.  
  320.   if (!early_exit)
  321.     printf ("\ncreating %s\n", dest_name);
  322.   else
  323.     printf ("\nfreeing code list...\n");
  324.  
  325.   if (!early_exit)
  326.     write_xrefs ();
  327.  
  328.   /* startup code */
  329.   fprintf (dest, "\n\tSECTION code,CODE\n\n");
  330.  
  331.   if (!module_opt)
  332.     {
  333.       /* 
  334.          ** Check for Wb start BEFORE DOING ANYTHING ELSE! 
  335.          ** This also always opens dos.library and stores 
  336.          ** CLI argument data. 
  337.        */
  338.       fprintf (dest, "\tjsr\t_startup\n");
  339.       fprintf (dest, "\tcmpi.b\t#1,_starterr\n");    /* see _startup in startup.lib */
  340.       fprintf (dest, "\tbne.s\t_START_PROG\n");
  341.       fprintf (dest, "\trts\n");
  342.       fprintf (dest, "_START_PROG:\n");
  343.  
  344.       /* storage for initial stack pointer */
  345.       enter_BSS ("_initialSP:", "ds.l 1");
  346.       fprintf (dest, "\tmove.l\tsp,_initialSP\n");    /* save task's stack pointer */
  347.  
  348.       fprintf (dest, "\tmovem.l\td1-d7/a0-a6,-(sp)\n");        /* save initial registers */
  349.  
  350.       if (cli_args)
  351.     fprintf (dest, "\tjsr\t_parse_cli_args\n");    /* get CLI arguments */
  352.  
  353.       if (translateused)
  354.     {
  355.       fprintf (dest, "\tjsr\t_opentranslator\n");
  356.       fprintf (dest, "\tcmpi.b\t#1,_starterr\n");
  357.       fprintf (dest, "\tbne.s\t_translate_ok\n");
  358.       fprintf (dest, "\tjmp\t_ABORT_PROG\n");
  359.       fprintf (dest, "_translate_ok:\n");
  360.     }
  361.  
  362.       if (mathffpused)
  363.     {
  364.       fprintf (dest, "\tjsr\t_openmathffp\n");
  365.       fprintf (dest, "\tcmpi.b\t#1,_starterr\n");
  366.       fprintf (dest, "\tbne.s\t_mathffp_ok\n");
  367.       fprintf (dest, "\tjmp\t_ABORT_PROG\n");
  368.       fprintf (dest, "_mathffp_ok:\n");
  369.     }
  370.  
  371.       if (mathtransused)
  372.     {
  373.       fprintf (dest, "\tjsr\t_openmathtrans\n");
  374.       fprintf (dest, "\tcmpi.b\t#1,_starterr\n");
  375.       fprintf (dest, "\tbne.s\t_mathtrans_ok\n");
  376.       fprintf (dest, "\tjmp\t_ABORT_PROG\n");
  377.       fprintf (dest, "_mathtrans_ok:\n");
  378.     }
  379.  
  380.       if (intuitionused && !gfxused)
  381.     {
  382.       fprintf (dest, "\tjsr\t_openintuition\n");
  383.       fprintf (dest, "\tcmpi.b\t#1,_starterr\n");
  384.       fprintf (dest, "\tbne.s\t_intuition_ok\n");
  385.       fprintf (dest, "\tjmp\t_ABORT_PROG\n");
  386.       fprintf (dest, "_intuition_ok:\n");
  387.     }
  388.  
  389.       if (gfxused)
  390.     {
  391.       /* open intuition.library */
  392.       fprintf (dest, "\tjsr\t_openintuition\n");
  393.       fprintf (dest, "\tcmpi.b\t#1,_starterr\n");
  394.       fprintf (dest, "\tbne.s\t_intuition_ok\n");
  395.       fprintf (dest, "\tjmp\t_ABORT_PROG\n");
  396.       fprintf (dest, "_intuition_ok:\n");
  397.  
  398.       /* open graphics.library */
  399.       fprintf (dest, "\tjsr\t_opengfx\n");
  400.       fprintf (dest, "\tcmpi.b\t#1,_starterr\n");
  401.       fprintf (dest, "\tbne.s\t_gfx_ok\n");
  402.       fprintf (dest, "\tjmp\t_ABORT_PROG\n");
  403.       fprintf (dest, "_gfx_ok:\n");
  404.     }
  405.  
  406.       /* create temporary ILBM.library */
  407.       if (iffused)
  408.     fprintf (dest, "\tjsr\t_create_ILBMLib\n");
  409.  
  410.       /* get timer event trapping start time */
  411.       if (ontimerused)
  412.     fprintf (dest, "\tjsr\t_ontimerstart\n");
  413.  
  414.       /* size of stack frame */
  415.       if (addr[lev] == 0)
  416.     strcpy (bytes, "#\0");
  417.       else
  418.     strcpy (bytes, "#-");
  419.       itoa (addr[lev], buf, 10L);
  420.       strcat (bytes, buf);
  421.  
  422.       /* create stack frame */
  423.       fprintf (dest, "\tlink\ta4,%s\n\n", bytes);
  424.  
  425.       /* initialise global DATA pointer */
  426.       if (basdatapresent)
  427.     fprintf (dest, "\tmove.l\t#_BASICdata,_dataptr\n");
  428.     }
  429.  
  430.   /* write code & kill code list */
  431.   kill_code ();
  432.  
  433.   if (!module_opt)
  434.     {
  435.       /* exiting code */
  436.       fprintf (dest, "\n_EXIT_PROG:\n");
  437.  
  438.       fprintf (dest, "\tunlk\ta4\n");
  439.  
  440.       /* 
  441.          ** Programs which abort should cleanup libraries, free allocated memory
  442.          ** and possibly reply to a Wb startup message. 
  443.        */
  444.       if (intuitionused || gfxused || mathffpused || mathtransused ||
  445.       translateused)
  446.     fprintf (dest, "_ABORT_PROG:\n");
  447.  
  448.       /* Free memory allocated via ALLOC and db.lib calls to alloc(). */
  449.       fprintf (dest, "\tjsr\t_free_alloc\n");
  450.  
  451.       /* close libraries */
  452.       if (gfxused)
  453.     {
  454.       fprintf (dest, "\tjsr\t_closegfx\n");
  455.       fprintf (dest, "\tjsr\t_closeintuition\n");
  456.     }
  457.       if (narratorused)
  458.     fprintf (dest, "\tjsr\t_cleanup_async_speech\n");
  459.       if (intuitionused && !gfxused)
  460.     fprintf (dest, "\tjsr\t_closeintuition\n");
  461.       if (mathtransused)
  462.     fprintf (dest, "\tjsr\t_closemathtrans\n");
  463.       if (mathffpused)
  464.     fprintf (dest, "\tjsr\t_closemathffp\n");
  465.       if (translateused)
  466.     fprintf (dest, "\tjsr\t_closetranslator\n");
  467.  
  468.       /* delete temporary ILBM.library */
  469.       if (iffused)
  470.     fprintf (dest, "\tjsr\t_remove_ILBMLib\n");
  471.  
  472.       /* restore registers */
  473.       fprintf (dest, "\tmovem.l\t(sp)+,d1-d7/a0-a6\n");
  474.  
  475.       /* restore initial stack pointer */
  476.       fprintf (dest, "\tmove.l\t_initialSP,sp\n");
  477.  
  478.       /* 
  479.          ** Close dos.library and reply to Wb message
  480.          ** as the LAST THING DONE before rts'ing.
  481.        */
  482.       fprintf (dest, "\tjsr\t_cleanup\n");
  483.  
  484.       /* return */
  485.       fprintf (dest, "\n\trts\n");
  486.     }
  487.  
  488.   if (!early_exit)
  489.     {
  490.       write_data ();
  491.       write_basdata ();
  492.       write_bss ();
  493.     }
  494.  
  495.   fprintf (dest, "\n\tEND\n");
  496.  
  497.   /* errors? */
  498.   if (errors > 0)
  499.     putchar ('\n');
  500.  
  501.   printf ("%s compiled ", source_name);
  502.  
  503.   if (errors == 0)
  504.     printf ("with no errors.\n");
  505.   else
  506.     {
  507.       exitvalue = 10;        /* set ERROR for bas script */
  508.       printf ("with %d ", errors);
  509.       if (errors > 1)
  510.     printf ("errors.\n");
  511.       else
  512.     printf ("error.\n");
  513.     }
  514.  
  515.   /* make icon? */
  516.   if (make_icon && !early_exit)
  517.     {
  518.       if ((icon_src = fopen ("ACE:icons/exe.info", "r")) == NULL)
  519.     puts ("can't open ACE:icons/exe.info for reading.");
  520.       else
  521.     {
  522.       cc = 0;
  523.       while (source_name[cc] != '.')
  524.         cc++;
  525.       source_name[cc] = '\0';
  526.       sprintf (icon_name, "%s.info", source_name);
  527.       if ((icon_dest = fopen (icon_name, "w")) == NULL)
  528.         printf ("can't open %s.info for writing.\n", source_name);
  529.       else
  530.         {
  531.           while (!feof (icon_src))
  532.         fputc (fgetc (icon_src), icon_dest);
  533.           fclose (icon_dest);
  534.           fclose (icon_src);
  535.           puts ("icon created.");
  536.         }
  537.     }
  538.     }
  539. }
  540.  
  541. void block (void)
  542. {
  543.   CODE *link;
  544.   SYM *sub_ptr;
  545.   char end_of_sub_name[80], end_of_sub_label[80];
  546.   char sub_name[80], sub_label[80], exit_sub_label[80];
  547.   char xdef_name[80];
  548.   char bytes[40], buf[40];
  549.   int subprog;
  550.   int sub_type, def_expr_type;
  551.  
  552.   while (!end_of_source)
  553.     {
  554.       if (sym != subsym && sym != defsym)
  555.     /* ordinary statement */
  556.     statement ();
  557.       else
  558.     {
  559. /************************/
  560.       /* SUBprogram or DEF FN */
  561. /************************/
  562.       subprog = sym;
  563.       insymbol ();
  564.  
  565.       sub_type = undefined;
  566.  
  567.       /* type identifiers */
  568.       if (sym == shortintsym || sym == longintsym || sym == addresssym ||
  569.           sym == singlesym || sym == stringsym)
  570.         {
  571.           switch (sym)
  572.         {
  573.         case shortintsym:
  574.           sub_type = shorttype;
  575.           break;
  576.         case longintsym:
  577.           sub_type = longtype;
  578.           break;
  579.         case addresssym:
  580.           sub_type = longtype;
  581.           break;
  582.         case singlesym:
  583.           sub_type = singletype;
  584.           break;
  585.         case stringsym:
  586.           sub_type = stringtype;
  587.           break;
  588.         }
  589.           insymbol ();
  590.         }
  591.  
  592.       if (sym != ident)
  593.         _error (32);
  594.       else
  595.         {
  596.           /* get name of subprogram and prefix _SUB_ to it */
  597.           strcpy (sub_name, "_SUB_");
  598.           strcat (sub_name, id);
  599.  
  600.           if (!exist (sub_name, subprogram))
  601.         {
  602.           if (sub_type == undefined)
  603.             sub_type = typ;
  604.           enter (sub_name, sub_type, subprogram, 0);    /* new SUB */
  605.           curr_item->decl = subdecl;
  606.         }
  607.           else if ((exist (sub_name, subprogram)) && (curr_item->decl == fwdref))
  608.         curr_item->decl = subdecl;
  609.           else
  610.         _error (33);    /* already exists */
  611.  
  612.           sub_ptr = curr_item;    /* pointer to sub info' */
  613.  
  614.           turn_event_off (sub_name);    /* see event.c */
  615.  
  616.           /* exit point name & label */
  617.           strcpy (exit_sub_name, "_EXIT");
  618.           strcat (exit_sub_name, sub_name);
  619.           strcpy (exit_sub_label, exit_sub_name);
  620.           strcat (exit_sub_label, ":\0");
  621.  
  622.           /* prepare for level ONE */
  623.           lev = ONE;
  624.           addr[lev] = 0;
  625.           new_symtab ();
  626.           make_label (end_of_sub_name, end_of_sub_label);
  627.           gen ("jmp", end_of_sub_name, "  ");
  628.  
  629.           /* subprogram label -> _SUB_ prefix to make it unique */
  630.           strcpy (sub_label, sub_name);
  631.           strcat (sub_label, ":\0");
  632.           gen (sub_label, "  ", "  ");
  633.  
  634.           /* all SUBs need link instruction -- add # of bytes later */
  635.           gen ("link", "a5", "  ");
  636.           link = curr_code;
  637.  
  638.           /* parse formal parameter list */
  639.           sub_params (sub_ptr);
  640.  
  641.           /* make this subprogram externally visible? */
  642.           if (sym == externalsym)
  643.         {
  644.           insymbol ();
  645.           strcpy (xdef_name, sub_name);
  646.           xdef_name[0] = '*';    /* signal that this is an XDEF */
  647.           enter_XREF (xdef_name);
  648.         }
  649.  
  650.           /* 
  651.              ** Pass function (SUB) values via d0 for ALL subprograms 
  652.              ** in a module since there is no link using A4 for modules.
  653.            */
  654.           if (module_opt)
  655.         sub_ptr->address = extfunc;    /* This has a numeric value of 3004:
  656.                            hopefully large enough to avoid
  657.                            clashes with real stack offsets. */
  658.  
  659.           /* SUB or DEF FN code? */
  660.           if (subprog == subsym)
  661.         {
  662.           while ((sym != endsym) && (!end_of_source))
  663.             {
  664.               if (sym == sharedsym)
  665.             parse_shared_vars ();
  666.               if ((sym != endsym) && (!end_of_source))
  667.             statement ();
  668.             }
  669.  
  670.           if (end_of_source)
  671.             _error (34);    /* END SUB expected */
  672.  
  673.           if (sym == endsym)
  674.             {
  675.               insymbol ();
  676.               if (sym != subsym)
  677.             _error (35);
  678.               insymbol ();
  679.             }
  680.         }
  681.           else
  682.         {
  683.           /* DEF FN code */
  684.           if (sym != equal)
  685.             _error (5);
  686.           else
  687.             {
  688.               insymbol ();
  689.               def_expr_type = expr ();
  690.               if (assign_coerce (sub_type, def_expr_type) != sub_type)
  691.             _error (4);
  692.               else if (sub_type == shorttype)
  693.             gen ("move.w", "(sp)+", "d0");
  694.               else
  695.             gen ("move.l", "(sp)+", "d0");
  696.  
  697.               /* change object from SUB to DEF FN */
  698.               sub_ptr->object = definedfunc;
  699.             }
  700.         }
  701.  
  702.           /* establish size of stack frame */
  703.           if (addr[lev] == 0)
  704.         strcpy (bytes, "#\0");
  705.           else
  706.         strcpy (bytes, "#-");
  707.           itoa (addr[lev], buf, 10L);
  708.           strcat (bytes, buf);
  709.           change (link, "link", "a5", bytes);
  710.  
  711.           /* exit code */
  712.           if (subprog == subsym)
  713.         gen (exit_sub_label, "  ", "  ");
  714.           gen ("unlk", "a5", "  ");
  715.           gen ("rts", "  ", "  ");
  716.           gen (end_of_sub_label, "  ", "  ");
  717.  
  718.           kill_symtab ();
  719.           lev = ZERO;
  720.         }
  721.     }
  722.     }
  723. }
  724.  
  725. /* functions  sub.c */
  726. void load_params (SYM * sub_ptr)
  727. {
  728.   long par_addr = -8;        /* one word above stack frame 
  729.                    (allows for R.A. & address reg store) */
  730.   SHORT i, n;
  731.   int formal_type;
  732.   char addrbuf[40];
  733.   char formaltemp[MAXPARAMS][80], formaladdr[MAXPARAMS][80];
  734.   int formaltype[MAXPARAMS];
  735.  
  736.   /* store actual parameters in stack frame of subprogram to be CALLed */
  737.  
  738.   if (sym != lparen)
  739.     {
  740.       _error (14);
  741.       return;
  742.     }
  743.   else
  744.     {
  745.       i = 0;
  746.       do
  747.     {
  748.       insymbol ();
  749.       formal_type = expr ();
  750.  
  751.       /* check parameter types */
  752.       if (formal_type != sub_ptr->p_type[i])
  753.         {
  754.           /* coerce actual parameter type to formal parameter type */
  755.           switch (sub_ptr->p_type[i])
  756.         {
  757.         case shorttype:
  758.           make_sure_short (formal_type);
  759.           break;
  760.  
  761.         case longtype:
  762.           if ((formal_type = make_integer (formal_type)) == shorttype)
  763.             make_long ();
  764.           else if (formal_type == notype)
  765.             _error (4);    /* string */
  766.           break;
  767.  
  768.         case singletype:
  769.           gen_Flt (formal_type);
  770.           break;
  771.  
  772.         case stringtype:
  773.           _error (4);    /* can't coerce this at all! */
  774.           break;
  775.         }
  776.         }
  777.  
  778.       /* store parameter information temporarily since further stack operations  
  779.          may corrupt data in next frame if stored immediately */
  780.       if (sub_ptr->p_type[i] == shorttype)
  781.         {
  782.           par_addr -= 2;
  783.           /* save parameter type */
  784.           formaltype[i] = shorttype;    /* not data TYPE but STORE type (2 or 4 bytes) */
  785.  
  786.           /* save address of formal */
  787.           itoa (par_addr, addrbuf, 10);
  788.           strcat (addrbuf, "(sp)");
  789.           strcpy (formaladdr[i], addrbuf);
  790.  
  791.           /* create temporary store in current stack frame -> don't use a global
  792.              data object as it could be clobbered during recursion! */
  793.           addr[lev] += 2;
  794.           itoa (-1 * addr[lev], formaltemp[i], 10L);
  795.           strcat (formaltemp[i], frame_ptr[lev]);
  796.  
  797.           /* store it */
  798.           gen ("move.w", "(sp)+", formaltemp[i]);
  799.         }
  800.       else
  801.         /* long, single, string, array */
  802.         {
  803.           par_addr -= 4;
  804.           /* save parameter type */
  805.           formaltype[i] = longtype;        /* storage requirement is 4 bytes */
  806.  
  807.           /* save address of formal */
  808.           itoa (par_addr, addrbuf, 10);
  809.           strcat (addrbuf, "(sp)");
  810.           strcpy (formaladdr[i], addrbuf);
  811.  
  812.           /* create temporary store in current stack frame -> don't use a global
  813.              data object as it could be clobbered during recursion! */
  814.           addr[lev] += 4;
  815.           itoa (-1 * addr[lev], formaltemp[i], 10L);
  816.           strcat (formaltemp[i], frame_ptr[lev]);
  817.  
  818.           /* store it */
  819.           gen ("move.l", "(sp)+", formaltemp[i]);
  820.         }
  821.  
  822.       i++;
  823.     }
  824.       while ((i < sub_ptr->no_of_params) && (sym == comma));
  825.  
  826.       if ((i < sub_ptr->no_of_params) || (sym == comma))
  827.     _error (39);        /* parameter count mismatch - too few or too many resp. */
  828.       else
  829.     {
  830.       /* disable multi-tasking 
  831.          before passing parameters */
  832.       gen ("movea.l", "_AbsExecBase", "a6");
  833.       gen ("jsr", "_LVOForbid(a6)", "  ");
  834.       enter_XREF ("_AbsExecBase");
  835.       enter_XREF ("_LVOForbid");
  836.  
  837.       /* load parameters into next frame */
  838.       for (n = 0; n < sub_ptr->no_of_params; n++)
  839.         {
  840.           if (formaltype[n] == shorttype)
  841.         gen ("move.w", formaltemp[n], formaladdr[n]);    /* short */
  842.           else
  843.         gen ("move.l", formaltemp[n], formaladdr[n]);    /* long,string,single,array */
  844.         }
  845.     }
  846.  
  847.       if (sym != rparen)
  848.     _error (9);
  849.     }
  850. }
  851.